home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 2: CDPD 1 / Almathera Ten on Ten - Disc 2: CDPD 1.iso / pd / 101-125 / 118 / empire / src / source.zoo / util.d < prev   
Text File  |  1987-12-02  |  15KB  |  677 lines
  1. #include:util.g
  2. #include:libraries/dos.g
  3. #empire.g
  4. #empfunc.g
  5.  
  6. /*
  7.  * readLine - read a line, terminating with a \e.
  8.  */
  9.  
  10. proc readLine(*char buffer; uint length)bool:
  11.     ulong gotLength;
  12.     bool result;
  13.  
  14.     gotLength := LineRead(Chin, buffer, length - 1);
  15.     if gotLength = LINE_EOF then
  16.     pretend(ioerror(Chin), void);
  17.     result := false;
  18.     else
  19.     if gotLength >= length then
  20.         gotLength := length - 1;
  21.     fi;
  22.     (buffer + gotLength)* := '\e';
  23.     result := true;
  24.     fi;
  25.     result
  26. corp;
  27.  
  28. /*
  29.  * ask - ask a question, return true for 'y' answer.
  30.  */
  31.  
  32. proc ask(*char question)bool:
  33.     char answer;
  34.  
  35.     while
  36.     write(PromptOut; question);
  37.     if not readln(Chin; answer) then
  38.         pretend(ioerror(Chin), void);
  39.         if not readln(Chin;) then
  40.         pretend(ioerror(Chin), void);
  41.         fi;
  42.         answer := 'n';
  43.     fi;
  44.     answer ~= 'y' and answer ~= 'n'
  45.     do
  46.     writeln(PromptOut; "Please answer with 'y' or 'n'");
  47.     od;
  48.     answer = 'y'
  49. corp;
  50.  
  51. /*
  52.  * lookupCommand - look up a command in a table of command names.
  53.  *    If the name is unambiguous, return it's code number (2 - n + 2).
  54.  *    Return 0 if the command is not found, 1 if it's ambiguous.
  55.  */
  56.  
  57. proc lookupCommand(*char commandList, command)uint:
  58.     *char p;
  59.     uint i, which, found;
  60.  
  61.     i := 2;
  62.     found := 0;
  63.     while commandList* ~= '\e' do
  64.     p := command;
  65.     while p* = commandList* and p* ~= '\e' do
  66.         p := p + 1;
  67.         commandList := commandList + 1;
  68.     od;
  69.     if p* = '\e' then
  70.         which := i;
  71.         found := found + 1;
  72.     fi;
  73.     while commandList* ~= '\e' do
  74.         commandList := commandList + 1;
  75.     od;
  76.     commandList := commandList + 1;
  77.     i := i + 1;
  78.     od;
  79.     if found = 0 then
  80.     0
  81.     elif found = 1 then
  82.     which
  83.     else
  84.     1
  85.     fi
  86. corp;
  87.  
  88. /*
  89.  * writeDate - write a date from the given time. Note: the date is in seconds.
  90.  */
  91.  
  92. proc writeDate(ulong date)void:
  93.     [25] char buffer;
  94.  
  95.     ConvTime(date, &buffer[0]);
  96.     write(Chout; &buffer[0]);
  97. corp;
  98.  
  99. /*
  100.  * transRow - translate user row number to absolute row number.
  101.  */
  102.  
  103. proc transRow(int r)uint:
  104.  
  105.     r := r + ThisCountry*.c_centerRow;
  106.     while r < 0 do
  107.     r := r + World.w_rows;
  108.     od;
  109.     r % World.w_rows
  110. corp;
  111.  
  112. /*
  113.  * transCol - translate user column number to absolute column number.
  114.  */
  115.  
  116. proc transCol(int c)uint:
  117.  
  118.     c := c + ThisCountry*.c_centerCol;
  119.     while c < 0 do
  120.     c := c + World.w_columns;
  121.     od;
  122.     c % World.w_columns
  123. corp;
  124.  
  125. /*
  126.  * err - print an error message.
  127.  */
  128.  
  129. proc err(*char mess)void:
  130.  
  131.     writeln(Chout; "*** ", mess, " ***");
  132. corp;
  133.  
  134. /*
  135.  * getDesigName - return the full string for a sector type name.
  136.  */
  137.  
  138. proc getDesigName(SectorType_t desig)*char:
  139.  
  140.      case desig
  141.      incase s_water:
  142.       "sea"
  143.      incase s_mountain:
  144.       "mountain"
  145.      incase s_wilderness:
  146.       "wilderness"
  147.      incase s_sanctuary:
  148.       "sanctuary"
  149.      incase s_capital:
  150.       "capital"
  151.      incase s_urban:
  152.       "urban area"
  153.      incase s_defense:
  154.       "defense plant"
  155.      incase s_industry:
  156.       "shell industry"
  157.      incase s_ironMine:
  158.       "mine"
  159.      incase s_goldMine:
  160.       "gold mine"
  161.      incase s_harbour:
  162.       "harbor"
  163.      incase s_warehouse:
  164.       "warehouse"
  165.      incase s_technical:
  166.       "technical center"
  167.      incase s_fortress:
  168.       "fortress"
  169.      incase s_airport:
  170.       "airport"
  171.      incase s_research:
  172.       "research laboratory"
  173.      incase s_highway:
  174.       "highway"
  175.      incase s_radar:
  176.       "radar station"
  177.      incase s_weather:
  178.       "weather station"
  179.      incase s_bridgeHead:
  180.       "bridge head"
  181.      incase s_bridgeSpan:
  182.       "bridge span"
  183.      incase s_bank:
  184.       "bank"
  185.      incase s_exchange:
  186.       "exchange"
  187.      default:
  188.       "???? unknown desig ????"
  189.      esac
  190. corp;
  191.  
  192. /*
  193.  * getItemName - return the full string name for a commodity.
  194.  */
  195.  
  196. proc getItemName(ItemType_t item)*char:
  197.  
  198.     case item
  199.     incase it_civilians:
  200.     "civilians"
  201.     incase it_military:
  202.     "military"
  203.     incase it_shells:
  204.     "shells"
  205.     incase it_guns:
  206.     "guns"
  207.     incase it_planes:
  208.     "planes"
  209.     incase it_ore:
  210.     "ore"
  211.     incase it_bars:
  212.     "bars"
  213.     default:
  214.     "??? unknown item ???"
  215.     esac
  216. corp;
  217.  
  218. /*
  219.  * getShipName - return the full string name for a ship.
  220.  */
  221.  
  222. proc getShipName(ShipType_t typ)*char:
  223.  
  224.     case typ
  225.     incase st_PTBoat:
  226.     "PT boat"
  227.     incase st_mineSweeper:
  228.     "minesweeper"
  229.     incase st_destroyer:
  230.     "destroyer"
  231.     incase st_submarine:
  232.     "submarine"
  233.     incase st_freighter:
  234.     "freighter"
  235.     incase st_tender:
  236.     "tender"
  237.     incase st_battleship:
  238.     "battleship"
  239.     incase st_carrier:
  240.     "carrier"
  241.     default:
  242.     "??? unknown ship ???"
  243.     esac
  244. corp;
  245.  
  246. /*
  247.  * getIndex - return the index of a character in a character array.
  248.  */
  249.  
  250. proc getIndex(*char types; char typ)uint:
  251.     uint index;
  252.  
  253.     index := 0;
  254.     while types* ~= typ do
  255.     if types* = '\e' then
  256.         abort("getIndex: typ not found in types");
  257.     fi;
  258.     types := types + sizeof(char);
  259.     index := index + 1;
  260.     od;
  261.     index
  262. corp;
  263.  
  264. /*
  265.  * getShipIndex - return the index of the given ship type code.
  266.  */
  267.  
  268. proc getShipIndex(char shipType)uint:
  269.  
  270.     getIndex(&ShipChar[0], shipType)
  271. corp;
  272.  
  273. /*
  274.  * getItemIndex - return the index of the given item type code.
  275.  */
  276.  
  277. proc getItemIndex(char itemType)uint:
  278.  
  279.     getIndex(&ItemChar[0], itemType)
  280. corp;
  281.  
  282. /*
  283.  * min - return the minimum of two ints.
  284.  */
  285.  
  286. proc min(int a, b)int:
  287.  
  288.     if a < b then a else b fi
  289. corp;
  290.  
  291. /*
  292.  * umin - return the minimum of two uints.
  293.  */
  294.  
  295. proc umin(uint a, b)uint:
  296.  
  297.     if a < b then a else b fi
  298. corp;
  299.  
  300. /*
  301.  * updateTimer - Updates time limit counter, returns 'true' if we should quit
  302.  */
  303.  
  304. proc updateTimer()bool:
  305.     ulong now, dt;
  306.  
  307.     weatherUpdate();
  308.     now := CurrentTime();
  309.     if ThisCountryNumber = DEITY then
  310.     false
  311.     elif ThisCountry*.c_last / (24 * 60 * 60) ~= now / (24 * 60 * 60) then
  312.     /* it's now the next day - reset timer */
  313.     ThisCountry*.c_last := now;
  314.     ThisCountry*.c_timer := World.w_maxConnect;
  315.     false
  316.     else
  317.     if ThisCountry*.c_timer < (now - ThisCountry*.c_last) / 60 then
  318.         /* he's been here too long! - he should go away */
  319.         ThisCountry*.c_timer := 0;
  320.         true
  321.     else
  322.         dt := (now - ThisCountry*.c_last) / 60;
  323.         if dt >= 1 then
  324.         ThisCountry*.c_timer := ThisCountry*.c_timer - dt;
  325.         ThisCountry*.c_last := ThisCountry*.c_last + dt * 60;
  326.         fi;
  327.         false
  328.     fi
  329.     fi
  330. corp;
  331.  
  332. /*
  333.  * resetTimer - Resets the timer when you enter the program if you haven't
  334.  *    been in the program since 12 midnight. Also recalculate BTUS.
  335.  *    Returns 'true' if you are out of time for the day.
  336.  */
  337.  
  338. proc resetTimer()bool:
  339.     Sector_t s;
  340.     ulong now;
  341.  
  342.     weatherUpdate();
  343.     now := CurrentTime();
  344.     if ThisCountryNumber = DEITY then
  345.     ThisCountry*.c_timer := 999;
  346.     ThisCountry*.c_last := now;
  347.     false
  348.     else
  349.     readSector(0, 0, s);
  350.     if updateSector(0, 0, s) then
  351.         writeSector(0, 0, s);
  352.     fi;
  353.     /* Check to see if we changed days since the last access */
  354.     if ThisCountry*.c_last / (24 * 60 * 60) ~= now / (24 * 60 * 60) then
  355.         ThisCountry*.c_timer := World.w_maxConnect;
  356.     fi;
  357.     ThisCountry*.c_last := now;
  358.     ThisCountry*.c_timer = 0
  359.     fi
  360. corp;
  361.  
  362. /*
  363.  * accessSector - read a sector, update it, and write it back out if needed.
  364.  *    The caller need not write it out again, and if he wants to, he should
  365.  *    use readSector/writeSector to save on disk I/O.
  366.  */
  367.  
  368. proc accessSector(int row, col; Sector_t s)void:
  369.  
  370.     readSector(row, col, s);
  371.     if updateSector(row, col, s) then
  372.     writeSector(row, col, s);
  373.     fi;
  374. corp;
  375.  
  376. /*
  377.  * accessShip - read a ship, update it, and write it out if needed.
  378.  */
  379.  
  380. proc accessShip(uint shipNumber; Ship_t sh)void:
  381.  
  382.     readShip(shipNumber, sh);
  383.     if updateShip(shipNumber, sh) then
  384.     writeShip(shipNumber, sh);
  385.     fi;
  386. corp;
  387.  
  388. /*
  389.  * getBundleSize - get the size of the storage bundle for given types.
  390.  */
  391.  
  392. proc getBundleSize(SectorType_t sectorType; ItemType_t thingType)uint:
  393.  
  394.     if sectorType = s_warehouse then
  395.     if thingType = it_shells or thingType = it_guns or
  396.         thingType = it_ore then
  397.          10
  398.     else
  399.          1
  400.     fi
  401.     elif sectorType = s_urban then
  402.     if thingType = it_civilians then 10 else 1 fi
  403.     elif sectorType = s_bank then
  404.     if thingType = it_bars then 4 else 1 fi
  405.     else
  406.     1
  407.     fi
  408. corp;
  409.  
  410. /*
  411.  * readQuan - return the current quantity of the indicated commodity at the
  412.  *      passed sector.
  413.  */
  414.  
  415. proc readQuan(Sector_t s; ItemType_t what)uint:
  416.  
  417.     getBundleSize(s.s_type, what) * s.s_quantity[what]
  418. corp;
  419.  
  420. /*
  421.  * writeQuan - write the given quantity of the indicated commodity to the
  422.  *      passed sector. Any excess is discarded silently.
  423.  */
  424.  
  425. proc writeQuan(Sector_t s; ItemType_t what; uint quan)void:
  426.     char desig;
  427.  
  428.     s.s_quantity[what] := min(127, quan / getBundleSize(s.s_type, what));
  429. corp;
  430.  
  431. /*
  432.  * getTransportCost - get the transportion cost of moving the given quantity
  433.  *    of the given thing out of the given type of sector. Note that the
  434.  *    cost is rounded up to the next shipment bundle size. We assume that
  435.  *    the quantity is already rounded up to the storage bundle size.
  436.  */
  437.  
  438. proc getTransportCost(SectorType_t sectorType; ItemType_t thingType;
  439.               uint quantity)uint:
  440.     uint bundleSize;
  441.  
  442.     bundleSize := getBundleSize(sectorType, thingType);
  443.     case thingType
  444.     incase it_civilians:
  445.     /* civMob mobility per 5 bundles of civilians */
  446.     (quantity + 4 * bundleSize) / (5 * bundleSize) * World.w_civMob
  447.     incase it_military:
  448.     /* milMob mobility per 5 bundles of military */
  449.     (quantity + 4 * bundleSize) / (5 * bundleSize) * World.w_milMob
  450.     incase it_shells:
  451.     /* shellMob mobility per 5 bundles of shells */
  452.     (quantity + 4 * bundleSize) / (5 * bundleSize) * World.w_shellMob
  453.     incase it_guns:
  454.     /* gunMob mobility per bundle of guns */
  455.     quantity / bundleSize * World.w_gunMob
  456.     incase it_planes:
  457.     /* planeMob mobility per bundle of planes */
  458.     quantity / bundleSize * World.w_planeMob
  459.     incase it_ore:
  460.     /* World.w_oreMob mobility per 5 bundles of ore */
  461.     (quantity + 4 * bundleSize) / (5 * bundleSize) * World.w_oreMob
  462.     incase it_bars:
  463.     /* barMob mobility per bar, except barMob / 2 per bar leaving a bank */
  464.     if sectorType = s_bank then
  465.         quantity * World.w_barMob / 2
  466.     else
  467.         quantity * World.w_barMob
  468.     fi
  469.     default:
  470.     err("unknown item type in 'getTransportCost'");
  471.     quantity
  472.     esac
  473. corp;
  474.  
  475. /*
  476.  * getTerrainCost - scale the cost for movement onto the given sector.
  477.  */
  478.  
  479. proc getTerrainCost(Sector_t s; ulong cost)ulong:
  480.  
  481.     if s.s_type = s_highway or s.s_type = s_bridgeSpan then
  482.     cost * (100 - s.s_efficiency) / 100
  483.     elif s.s_type = s_mountain then
  484.     cost * World.w_mountMob
  485.     elif s.s_type = s_wilderness then
  486.     cost * World.w_wildMob
  487.     else
  488.     cost * World.w_defMob
  489.     fi
  490. corp;
  491.  
  492. /*
  493.  * adjustForNewWorkers - new workers have just been moved into the sector -
  494.  *    fix it up so as to not loose mobility or gain work.
  495.  */
  496.  
  497. proc adjustForNewWorkers(Sector_t s; ItemType_t what; uint quantity)void:
  498.     ulong now, dt, dt2, iwork;
  499.     uint workForce;
  500.     [25] char buff;
  501.  
  502.     /* we have to keep any work pending in the target
  503.        sector correct. We do this by moving its last
  504.        update time forward as required. */
  505.     /* workforce BEFORE the new guys added: */
  506.     workForce :=
  507.     if what = it_civilians then
  508.         quantity + s.s_quantity[it_military] / 5
  509.     else
  510.         s.s_quantity[it_civilians] + quantity / 5
  511.     fi;
  512.     now := CurrentTime();
  513.     if s.s_lastUpdate = 0 or s.s_lastUpdate > now or
  514.         s.s_lastUpdate < now - (7 * 24 * 60 * 60) and workForce ~= 0 then
  515.     if s.s_lastUpdate ~= 0 then
  516.         ConvTime(now, &buff[0]);
  517.         write(LogChannel; "*** 'adjustForNewWorkers': now = ", &buff[0]);
  518.         ConvTime(s.s_lastUpdate, &buff[0]);
  519.         writeln(LogChannel; ", lastUpdate = ", &buff[0]);
  520.     fi;
  521.     s.s_lastUpdate := now / (60 * 30) * (60 * 30);
  522.     fi;
  523.     dt := (now - s.s_lastUpdate) / (60 * 30);
  524.     /* work pending in the sector: */
  525.     iwork := workForce * dt;
  526.     /* workforce AFTER the new guys added: */
  527.     workForce := s.s_quantity[it_civilians] + s.s_quantity[it_military] / 5;
  528.     /* time they would have taken to do the work: */
  529.     dt2 := iwork / workForce;
  530.     /* add mobility since it's not dependent on iwork: */
  531.     s.s_mobility := min(127, s.s_mobility + (dt - dt2));
  532.     /* and crank the update time forward: */
  533.     s.s_lastUpdate := (now / (60 * 30) - dt2) * (60 * 30);
  534. corp;
  535.  
  536. /*
  537.  * getTechFactor - return the country's current technology factor.
  538.  *    (range returned is 0 - 99)
  539.  */
  540.  
  541. proc getTechFactor(uint country)uint:
  542.     ulong level;
  543.  
  544.     level := Country[country].c_techLevel;
  545.     (250000 + 6175 * level) / (10000 + 61 * level)
  546. corp;
  547.  
  548. /*
  549.  * getDefender - return the coordinates of a defending fort.
  550.  */
  551.  
  552. proc getDefender(int r, c; Sector_t s; *int pRow, pCol)void:
  553.     uint defender;
  554.  
  555.     defender := s.s_defender;
  556.     pRow* := r + (defender >> 4) - 8;
  557.     pCol* := c + (defender & 0xf) - 8;
  558. corp;
  559.  
  560. /*
  561.  * putDefender - store a defender offset value.
  562.  */
  563.  
  564. proc putDefender(int r, c; Sector_t s; int rDefender, cDefender)void:
  565.  
  566.     s.s_defender := make(rDefender + 8 - r, uint) << 4 |
  567.                  make(cDefender + 8 - c, uint);
  568. corp;
  569.  
  570. /*
  571.  * findDistance - return the square of the distance between two locations.
  572.  */
  573.  
  574. proc findDistance(int r1, c1, r2, c2)uint:
  575.     uint d1, d2;
  576.  
  577.     d1 := |(r1 - r2);
  578.     while d1 >= World.w_rows do
  579.     d1 := d1 - World.w_rows;
  580.     od;
  581.     if d1 > World.w_rows / 2 then
  582.     d1 := World.w_rows - d1;
  583.     fi;
  584.     d2 := |(c1 - c2);
  585.     while d2 >= World.w_columns do
  586.     d2 := d2 - World.w_columns;
  587.     od;
  588.     if d2 > World.w_columns / 2 then
  589.     d2 := World.w_columns - d2;
  590.     fi;
  591.     d1 * d1 + d2 * d2
  592. corp;
  593.  
  594. /*
  595.  * getItemCost - return the cost per unit of various items.
  596.  */
  597.  
  598. proc getItemCost(ItemType_t what)uint:
  599.  
  600.     case what
  601.     incase it_shells:
  602.     World.w_shellCost
  603.     incase it_guns:
  604.     World.w_gunCost
  605.     incase it_planes:
  606.     World.w_planeCost
  607.     incase it_bars:
  608.     World.w_barCost
  609.     default:
  610.     1
  611.     esac
  612. corp;
  613.  
  614. /*
  615.  * readShipQuan - read the quantity of stuff the ship is carrying.
  616.  */
  617.  
  618. proc readShipQuan(Ship_t sh; ItemType_t what)uint:
  619.  
  620.     case what
  621.     incase it_civilians:
  622.     incase it_military:
  623.     sh.sh_crew
  624.     incase it_shells:
  625.     sh.sh_shells
  626.     incase it_guns:
  627.     sh.sh_guns
  628.     incase it_planes:
  629.     sh.sh_planes
  630.     incase it_ore:
  631.     sh.sh_ore
  632.     incase it_bars:
  633.     sh.sh_bars
  634.     default:
  635.     err("unknown item in 'readShipQuan'");
  636.     0
  637.     esac
  638. corp;
  639.  
  640. /*
  641.  * writeShipQuan - write the quantity of stuff to the ship.
  642.  */
  643.  
  644. proc writeShipQuan(Ship_t sh; ItemType_t what; uint quantity)void:
  645.  
  646.     case what
  647.     incase it_civilians:
  648.     incase it_military:
  649.     sh.sh_crew := quantity;
  650.     incase it_shells:
  651.     sh.sh_shells := quantity;
  652.     incase it_guns:
  653.     sh.sh_guns := quantity;
  654.     incase it_planes:
  655.     sh.sh_planes := quantity;
  656.     incase it_ore:
  657.     sh.sh_ore := quantity;
  658.     incase it_bars:
  659.     sh.sh_bars := quantity;
  660.     default:
  661.     err("unknown item in 'writeShipQuan'");
  662.     esac;
  663. corp;
  664.  
  665. /*
  666.  * getNavCost - return the cost of navigating the given ship type one
  667.  *    sector orthogonally. The result is x 10.
  668.  */
  669.  
  670. proc getNavCost(ShipType_t shipType)uint:
  671.     uint tf;
  672.  
  673.     tf := getTechFactor(ThisCountryNumber);
  674.     make(World.w_shipSpeed[shipType], ulong) *
  675.      (10000 / tf * 2) / (10000 / tf + 100) / 10
  676. corp;
  677.